home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / emacs.tcl < prev    next >
Encoding:
Text File  |  1998-11-18  |  5.1 KB  |  252 lines  |  [TEXT/ALFA]
  1.  
  2. alpha::extension emacs 0.24 {
  3.     newPref f useEmacsMenu 1 global emacsToggle
  4.     newPref f emacLastWordIfTouching 0 global effectLastToggle
  5.     menu::buildProc emacs emacsBindings
  6.     emacsToggle
  7.     effectLastToggle
  8.     alpha::addToPreferencePage Packages emacLastWordIfTouching useEmacsMenu
  9. } help {file "Emacs Help"}
  10.  
  11.  
  12. proc effectLastToggle {args} {
  13.     global emacLastWordIfTouching
  14.     if $emacLastWordIfTouching {
  15.         if {[info command __upcaseWord] == ""} {
  16.             rename upcaseWord __upcaseWord
  17.             rename downcaseWord __downcaseWord
  18.             rename capitalizeWord __capitalizeWord
  19.         }
  20.         ;proc upcaseWord {} {
  21.             set p [getPos]
  22.             backwardWord
  23.             set sw [getPos]
  24.             forwardWord
  25.             set ew [getPos]
  26.             goto $p
  27.             if {[pos::compare $p == $ew]} {
  28.                 backwardWord
  29.                 __upcaseWord
  30.             } else {
  31.                 __upcaseWord
  32.             }
  33.         }
  34.         ;proc downcaseWord {} {
  35.             set p [getPos]
  36.             backwardWord
  37.             set sw [getPos]
  38.             forwardWord
  39.             set ew [getPos]
  40.             goto $p
  41.             if {[pos::compare $p == $ew]} {
  42.                 backwardWord
  43.                 __downcaseWord
  44.             } else {
  45.                 __downcaseWord
  46.             }
  47.         }
  48.         ;proc capitalizeWord {} {
  49.             set p [getPos]
  50.             backwardWord
  51.             set sw [getPos]
  52.             forwardWord
  53.             set ew [getPos]
  54.             goto $p
  55.             if {[pos::compare $p == $ew]} {
  56.                 backwardWord
  57.                 while {![regexp {\w} [lookAt [getPos]]]} {
  58.                     forwardChar
  59.                 }
  60.                 __capitalizeWord
  61.             } else {
  62.                 __capitalizeWord
  63.             }
  64.         }
  65.         unBind 'h' <z>    hiliteWord
  66.         Bind 'h' <z>    touchHiliteWord
  67.     } else {
  68.         if {[info command __upcaseWord] != ""} {
  69.             rename upcaseWord {}
  70.             rename downcaseWord {}
  71.             rename capitalizeWord {}
  72.  
  73.             rename __upcaseWord upcaseWord
  74.             rename __downcaseWord downcaseWord
  75.             rename __capitalizeWord capitalizeWord
  76.             unBind 'h' <z>    touchHiliteWord
  77.             Bind 'h' <z>    hiliteWord
  78.         }
  79.     }
  80. }
  81.  
  82. proc touchHiliteWord {} {
  83.     if {[pos::compare [getPos]==[selEnd]]} {
  84.         set p [getPos]
  85.         backwardWord
  86.         set sw [getPos]
  87.         forwardWord
  88.         set ew [getPos]
  89.         goto $p
  90.         if {[pos::compare $p == $ew]} {
  91.             select $sw $ew
  92.         } else {
  93.             forwardWord
  94.             set start [getPos]
  95.             backwardWord
  96.             select $start [getPos]
  97.         }
  98.     } else {
  99.         forwardChar
  100.         forwardWord
  101.         set start [getPos]
  102.         backwardWord
  103.         select $start [getPos]
  104.     }
  105. }
  106.  
  107. proc beginningOfLogicalLine {} {
  108.     beginningOfLine
  109.     set p [getPos]
  110.     set limit [pos::math [nextLineStart $p] - 1]
  111.     set llstart [search -f 1 -r 1 -n -l $limit {[^ \t\r\n]} $p]
  112.     if {$llstart != ""} {
  113.         goto [lindex $llstart 0]
  114.     }
  115. }
  116.  
  117. proc emacsToggle {args} {
  118.     global useEmacsMenu
  119.     if $useEmacsMenu {
  120.         menu::insert Edit submenu end emacs
  121.     } else {
  122.         menu::removeFrom Edit submenu end emacs
  123.         emacsBindings
  124.     }
  125. }
  126.  
  127. # Emacs-ish bindings.
  128. Bind 0x33 <e>      backwardDeleteWord
  129. Bind 'b' <es>    backwardWordSelect
  130. Bind '<' <se>     beginningOfBuffer
  131. Bind 'b' <X>    chooseWindowStatus
  132. Bind 'l' <X>    currentPosition
  133. Bind ')' <Xs>    endKeyboardMacro
  134. Bind '>' <se>     endOfBuffer
  135. Bind 'x' <Xz>    exchangePointAndMark
  136. Bind 'w' <Xz>    saveAs
  137. Bind 'e' <X>    executeKeyboardMacro
  138. Bind 'f' <Xz>    findFile
  139. Bind 'f' <es>     forwardWordSelect
  140. Bind 'c' <z>     prefixChar
  141. Bind 'x' <z>     prefixChar
  142. Bind 'r' <e>     repeatSearchBackward
  143. Bind 's' <e>     repeatSearchForward
  144. Bind 's' <Xz>    save
  145. Bind '(' <sX>    startKeyboardMacro
  146. Bind 'o' <X>    otherThing
  147. Bind '1' <X>    zoom
  148. Bind 'k' <X>    killWindowStatus
  149. Bind 'u' <X>    upcaseWord
  150.  
  151. Bind 'f' <e> forwardWord
  152. Bind 'b' <e> backwardWord
  153. Bind 'd' <e> deleteWord
  154. Bind 'h' <e> backwardDeleteWord
  155. Bind 'v' <e> pageBack
  156. Bind 'w' <e> copy
  157. Bind 'g' <e> gotoLine
  158. Bind 'e' <e> nextSentence
  159. Bind 'a' <e> prevSentence
  160. Bind 'c' <e> capitalizeWord
  161. Bind 'u' <e> upcaseWord
  162. Bind 'l' <e> downcaseWord
  163.  
  164. # added next -trf
  165. Bind 'm' <e> beginningOfLogicalLine
  166. Bind 'x' <e> execute
  167. Bind '\ '  <e> oneSpace
  168. Bind '\ '  <o> oneSpace
  169.  
  170. Bind 'd' <X>    killRegion
  171.  
  172. proc emacsBindings {} {
  173.     global useEmacsMenu
  174.     if $useEmacsMenu {
  175.         Menu -n emacs {
  176.         "/F<BforwardChar"
  177.         "/B<BbackwardChar"
  178.         "/D<BdeleteChar"
  179.         "/N<BnextLine"
  180.         "/P<BpreviousLine"
  181.         "(-"
  182.         "/F<IforwardWord"
  183.         "/B<IbackwardWord"
  184.         "/D<IdeleteWord"
  185.         "/v<IdeleteWord"
  186.         "/H<IbackwardDeleteWord"
  187.         "/u<IbackwardDeleteWord"
  188.         "(-"
  189.         "/K<BkillLine"
  190.         "/Y<Byank"
  191.         "/A<BbeginningOfLine"
  192.         "/E<BendOfLine"
  193.         "/O<BopenLine"
  194.         "(-"
  195.         "/V<BpageForward"
  196.         "/V<IpageBack"
  197.         "/L<BcenterRedraw"
  198.         "(-"
  199.         "/ <BsetMark"
  200.         "/W<Bcut"
  201.         "/W<Icopy"
  202.         "(-"
  203.         "/C<IcapitalizeWord"
  204.         "upcaseWord"
  205.         "/L<IdowncaseWord"
  206.         "(-"
  207.         "/X<Iexecute"
  208.         "/U<BiterationCount"
  209.         "/G<BabortEm"
  210.         }
  211.     } else {
  212.         Bind 'f' <z> forwardChar
  213.         Bind 'b' <z> backwardChar
  214.         Bind 'd' <z> deleteChar
  215.         Bind 'n' <z> nextLine
  216.         Bind 'p' <z> previousLine
  217.         Bind 'f' <o>  forwardWord
  218.         Bind 'b' <o>  backwardWord
  219.         Bind 'd' <o>  deleteWord
  220.         Bind 0x33 <so> deleteWord
  221.         Bind 'h' <o>  backwardDeleteWord
  222.         Bind 0x33 <o>  backwardDeleteWord
  223.         Bind 'k' <z> killLine
  224.         Bind 'y' <z> yank
  225.         Bind 'a' <z> beginningOfLine
  226.         Bind 'e' <z> endOfLine
  227.         Bind 'o' <z> openLine
  228.         Bind 'v' <z> pageForward
  229.         Bind 'v' <o> pageBack
  230.         Bind 'l' <z> centerRedraw
  231.         Bind '\ ' <z> setMark
  232.         Bind 'w' <z> cut
  233.         Bind 'w' <o> copy
  234.         Bind 'c' <o> capitalizeWord
  235.         Bind 'l' <o> downcaseWord
  236.         Bind 'x' <o> execute
  237.         Bind 'u' <z> iterationCount
  238.         Bind 'g' <z> abortEm
  239.     }
  240. }
  241.  
  242. proc killRegion {} {
  243.     set from [getMark]
  244.     set to [getPos]
  245.     if {[pos::compare $to < $from]} {
  246.     deleteText $to $from
  247.     } else {
  248.     deleteText $from $to
  249.     }
  250. }
  251.  
  252.